home *** CD-ROM | disk | FTP | other *** search
- MODULE IOUtils;
-
- {=============================================================================}
- {
- { Module for various IO operations:
- {
- { -- Reading cursorpatterns and fontpatterns
- { -- Clearing/blacking/inverting windows
- {
- {
- { Author: Petter Hesselberg
- {
- {=============================================================================}
-
- {=============================================================================}
- {
- { Changelog:
- {
- { V2.0 19 Jul 83 P Hesselberg ReadFont, PlaseCursor & Window routines
- { work perfectly!
- {
- { V1.0 19 Jul 83 P Hesselberg ReadCursor on the air
- {
- { V0.0 19 Jul 83 P Hesselberg Started (as a cursor test program)
- {
- {=============================================================================}
-
- {=============================================================================}
- EXPORTS
- {=============================================================================}
-
-
- IMPORTS IO_Others FROM IO_Others;
- IMPORTS Screen FROM Screen;
- IMPORTS UtilDefs FROM UtilDefs;
-
-
- {=============================================================================}
-
-
- FUNCTION ReadCursor(FileName : String): CurPatPtr;
-
- { Abstract: Creates a segment in memory and fills it with the cursor
- definition from <FileName>. Returns a pointer to the
- segment of type CurPatPtr defined in IO_Others.
- Returns NIL if file not found. }
-
-
- PROCEDURE PutCursor(Pointer : CurPatPtr;
- X : XRange;
- Y : YRange);
-
- { Abstract: Puts a copy of the cursor referenced by [Pointer]
- with upper left corner at coordinates (x, y) }
-
-
- FUNCTION ReadFont(FileName: String): FontPtr;
-
- { Abstract: Creates a segment in memory and fills it with the font
- definition from <FileName>. Returns a pointer to the
- segment of type FontPtr defined in Screen. }
-
-
- {=============================================================================}
-
-
- PROCEDURE ClearWindow(WNo: WinRange);
-
- { Abstract: Sets window [WNo] to white }
-
-
- PROCEDURE InvertWindow(WNo: WinRange);
-
- { Abstract: Inverts window [WNo] }
-
-
- PROCEDURE PaintWindow(WNo: WinRange);
-
- { Abstract: Sets window [WNo] to black }
-
-
-
- {#P}
- {=============================================================================}
- PRIVATE
- {=============================================================================}
-
-
- IMPORTS Memory FROM Memory;
- IMPORTS FileSystem FROM FileSystem;
- IMPORTS MultiRead FROM MultiRead;
- IMPORTS PERQ_String FROM PERQ_String;
-
- CONST CursorWidth = 56;
- CursorHeight = 64;
- DfltSizeInc = 1;
- DfltOffset = 0;
- FirstBlock = 0;
- NoFile = 0;
- Org = 0;
-
-
-
- {=============================================================================}
- { Cursor & Font Routines:
- {=============================================================================}
-
-
- FUNCTION ReadCursor(FileName: String): CurPatPtr;
-
- VAR Blocks, Bits, Seg : INTEGER;
- FID : FileID;
-
- BEGIN
- FID:= FSLookUp(FileName, Blocks, Bits);
- IF FID = NoFile THEN ReadCursor:= NIL
- ELSE
- BEGIN
- CreateSegment(Seg, Blocks, DfltSizeInc, Blocks);
- MultiRead(FID, MakePtr(Seg, DfltOffset, pDirBlk), FirstBlock,Blocks);
- ReadCursor:= MakePtr(Seg, DfltOffset, CurPatPtr);
- END
- END { ReadCursor };
-
-
- {=============================================================================}
-
-
- PROCEDURE PutCursor(Pointer: CurPatPtr;
- X : XRange;
- Y : YRange);
- BEGIN
- RasterOp(ROr, CursorWidth, CursorHeight, X, Y, SScreenW, SScreenP,
- Org, Org, 4, Pointer)
- END { PutCursor };
-
-
- {=============================================================================}
-
-
- FUNCTION ReadFont(FileName: String): FontPtr;
-
- VAR Blocks, Bits, Seg : INTEGER;
- FID : FileID;
-
- BEGIN
- FID:= FSLookUp(FileName, Blocks, Bits);
- IF FID = NoFile THEN ReadFont:= NIL
- ELSE
- BEGIN
- CreateSegment(Seg, Blocks, DfltSizeInc, Blocks);
- MultiRead(FID, MakePtr(Seg, DfltOffset, pDirBlk), FirstBlock,Blocks);
- ReadFont:= MakePtr(Seg, DfltOffset, FontPtr);
- END;
- END { ReadFont };
-
-
- {#P}
- {=============================================================================}
- { Window Handling procedures:
- {=============================================================================}
-
-
- PROCEDURE SetWindow(WNo : WinRange; Op : INTEGER); {******* Local to IOUtils }
-
- VAR Height, Width, OrgX, OrgY : INTEGER;
- HasTitle : BOOLEAN;
- Current : WinRange;
-
- BEGIN
- GetWindowParms(Current, OrgX, OrgY, Width, Height, HasTitle);
- ChangeWindow(WNo);
- GetWindowParms(WNo, OrgX, OrgY, Width, Height, HasTitle);
- RasterOp(Op, Width, Height,
- OrgX, OrgY,
- SScreenW, SScreenP,
- OrgX, OrgY,
- SScreenW, SScreenP);
- ChangeWindow(Current);
- END { SetWindow };
-
-
- {=============================================================================}
-
-
- PROCEDURE ClearWindow(WNo: WinRange);
- BEGIN
- SetWindow(WNo, RXor);
- END { ClearWindow };
-
-
- {=============================================================================}
-
-
- PROCEDURE InvertWindow(WNo: WinRange);
- BEGIN
- SetWindow(WNo, RNot);
- END { InvertWindow };
-
-
- {=============================================================================}
-
-
- PROCEDURE PaintWindow(WNo: WinRange);
- BEGIN
- SetWindow(WNo, RXNor);
- END { PaintWindow }.
-
-
-